home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt40s1.arc
/
GETUPLOA.MOD
< prev
next >
Wrap
Text File
|
1987-09-17
|
9KB
|
271 lines
(*----------------------------------------------------------------------*)
(* Get_Upload_Protocol --- Get Upload File Transfer Protocol *)
(*----------------------------------------------------------------------*)
FUNCTION Get_Upload_Protocol : Transfer_Type ;
(*----------------------------------------------------------------------*)
(* *)
(* Function: Get_Upload_Protocol *)
(* *)
(* Purpose: Gets file name and transfer protocol for upload. *)
(* *)
(* Calling Sequence: *)
(* *)
(* Transtyp := Get_Upload_Protocol: Transfer_Type; *)
(* *)
(* Remarks: *)
(* *)
(* Calls: KeyPressed *)
(* Async_Send *)
(* Async_Receive *)
(* *)
(*----------------------------------------------------------------------*)
CONST
Ascii_Quit_Item = 10;
VAR
Transfer_Kind : Transfer_Type;
Ascii_Menu : Menu_Type;
I : INTEGER;
J : INTEGER;
Pacing_String : STRING[10];
Ch : CHAR;
Get_FileName : BOOLEAN;
AFile : FILE;
(*----------------------------------------------------------------------*)
FUNCTION Yes_No_String( B: BOOLEAN ) : AnyStr;
BEGIN (* Yes_No_String *)
IF B THEN
Yes_No_String := 'YES'
ELSE
Yes_No_String := 'NO';
END (* Yes_No_String *);
(*----------------------------------------------------------------------*)
PROCEDURE Get_Ascii_Parameters;
VAR
Ascii_Done : BOOLEAN;
I : INTEGER;
J : INTEGER;
BEGIN (* Get_Ascii_Parameters *)
Make_A_Menu( Ascii_Menu, Ascii_Quit_Item, 3, 10, 50, 21, Ascii_Quit_Item,
'Ascii transfer parameters: ',
';;;;;;;;;Perform transfer;', TRUE );
Ascii_Done := FALSE;
REPEAT
FOR I := 1 TO ( Ascii_Quit_Item - 1 ) DO
WITH Ascii_Menu.Menu_Entries[I] DO
CASE I OF
1: Menu_Item_Text := 'a) Character delay (ms) (now ' +
IToS( Ascii_Char_Delay ) + ')';
2: Menu_Item_Text := 'b) Line delay (ms) (now ' +
IToS( Ascii_Line_Delay ) + ')';
3: Menu_Item_Text := 'c) Pacing character (now Ascii ' +
IToS( ORD( Ascii_Pacing_Char ) ) + ')';
4: Menu_Item_Text := 'd) Send file as byte stream (now ' +
Yes_No_String( Ascii_Send_Asis ) + ')';
5: Menu_Item_Text := 'e) Packet length ' +
'(now ' + IToS( Ascii_Line_Size ) + ')';
6: BEGIN
IF ( Ascii_CR_LF_String = CHR( CR ) ) THEN
Menu_Item_Text := 'f) End line with CR only'
ELSE
Menu_Item_Text := 'f) End line with CR + LF';
END;
7: Menu_Item_Text := 'g) Send empty line as blank (now ' +
Yes_No_String( Ascii_Send_Blank ) + ')';
8: Menu_Item_Text := 'h) Send ctrl-z at end of file (now ' +
Yes_No_String( Ascii_Use_CtrlZ ) + ')';
9: Menu_Item_Text := 'i) Display text transferred (now ' +
Yes_No_String( Ascii_Show_Text ) + ')';
END (* CASE *);
Menu_Display_Choices( Ascii_Menu );
I := Menu_Get_Choice( Ascii_Menu , Dont_Erase_Menu );
GoToXY( 2 , 12 );
ClrEol;
CASE I OF
1 : BEGIN
WRITE('Enter intercharacter delay:' );
IF Read_Number( Ascii_Char_Delay , TRUE , J ) THEN
Ascii_Char_Delay := J;
END;
2 : BEGIN
WRITE('Enter interline delay: ');
IF Read_Number( Ascii_Line_Delay , TRUE , J ) THEN
Ascii_Line_Delay := J;
END;
3 : BEGIN
WRITE('Enter pacing character: ');
Pacing_String := Write_Ctrls( Ascii_Pacing_Char );
Read_Edited_String( Pacing_String );
Pacing_String := Read_Ctrls( Pacing_String );
IF LENGTH( Pacing_String ) > 0 THEN
Ascii_Pacing_Char := Pacing_String[1]
ELSE
Ascii_Pacing_Char := CHR( NUL );
END;
4 : Ascii_Send_Asis := NOT Ascii_Send_Asis;
5 : BEGIN
WRITE('Enter packet length for stream transfer: ');
IF Read_Number( Ascii_Line_Size , TRUE , J ) THEN
Ascii_Line_Size := MAX( MIN( J , 255 ) , 1 );
END;
6 : BEGIN
IF ( Ascii_CR_LF_String = CHR( CR ) ) THEN
Ascii_CR_LF_String := CHR( CR ) + CHR( LF )
ELSE
Ascii_CR_LF_String := CHR( CR );
END;
7 : Ascii_Send_Blank := NOT Ascii_Send_Blank;
8 : Ascii_Use_CtrlZ := NOT Ascii_Use_CtrlZ;
9 : Ascii_Show_Text := NOT Ascii_Show_Text;
ELSE
Ascii_Done := TRUE;
END (* CASE *);
GoToXY( 2 , 12 );
ClrEol;
UNTIL ( Ascii_Done );
IF Ascii_Send_Asis THEN
BEGIN
Ascii_Send_Blank := FALSE;
Ascii_CR_LF_String[0] := #0;
END;
(*$I-*)
CLOSE( Afile );
(*$I+*)
(* Remove this window *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
END (* Get_Ascii_Parameters *);
(*----------------------------------------------------------------------*)
BEGIN (* Get_Upload_Protocol *)
(* Copy keyboard data before we screw *)
(* it up so we can get file name *)
Saved_Kbd_File_Name := Keyboard_Line;
(* No file name yet *)
FileName[0] := #0;
(* No protocol yet *)
Get_Upload_Protocol := None;
(* Display menu of transfer types *)
(* and get transfer kind. *)
Display_Transfer_Types( 'send', Transfer_Kind );
(* Get file name to transfer *)
Get_FileName := ( Transfer_Kind <> None );
IF ( Transfer_Kind = Kermit ) THEN
Get_FileName := FALSE;
IF Get_FileName THEN
BEGIN
GoToXY( 2 , 18 );
WRITE('Enter Filename.Ext: ');
GoToXY( 2 , 19 );
WRITE('>');
ClrEol;
IF Auto_Find_FileNames THEN
Get_Auto_File_Name( Saved_Kbd_File_Name , FileName );
Read_Edited_String(FileName);
WRITELN;
IF ( LENGTH( FileName ) = 0 ) THEN
BEGIN
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
EXIT;
END;
END;
(* Check that file exists *)
IF Single_File_Protocol[Transfer_Kind] THEN
BEGIN
ASSIGN(AFile,FileName);
(*$I- *)
RESET(AFile);
(*$I+ *)
IF ( Int24Result <> 0 ) THEN
BEGIN
Transfer_Kind := None;
WRITE('*** File not found, send cancelled ***');
DELAY( Two_Second_Delay );
END;
(*$I-*)
CLOSE( AFile );
(*$I+*)
I := Int24Result;
END;
(* Remove this window *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
(* Get parameters for Ascii transfer *)
IF ( Transfer_Kind = Ascii ) THEN
Get_Ascii_Parameters;
(* Return transfer protocol type *)
Get_Upload_Protocol := Transfer_Kind;
END (* Get_Upload_Protocol *);